00010	BEGIN "SEGMENT"
00020	DEFINE ⊂="COMMENT";	⊂ 5/30/73;
00030	⊂ This program has been simplified for use in getting segmentation
00040	results for the workshop. All on line output has been removed. The
00050	progra handle utterances of almost any length altho there is only
00060	space for 100 segments of each of three classes;
00070	
00080	REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00090	REQUIRE "BLOCKS.HDR[SYS,THO]" SOURCE_FILE;
00100	REQUIRE "SEGSIG" LOAD_MODULE;
00110	
00120	
00130	EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00140	EXTERNAL STRING PROCEDURE INCHWL;
00150	EXTERNAL PROCEDURE SPOOL(STRING S; INTEGER IOCHAN,FLAGS);
00160	DEFINE BUFSIZ="1024",CNTSIZ="100";
00170	STRING TFILEI,FILEI,OPT1,MESS;
00180	INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00190	INTEGER ARRAY LFILE[0:'177];
00200	INTEGER CHAN4,CHAN6,EOF,IEOF,FILEC;
00210	INTEGER BPT,SEGCNT,SEGTOT,H,I,J,K,L,Q;
00220	INTERNAL INTEGER M,N,P,RATE,FLAG,SEGC,INTOT,HINT,TFLAG,UPCNT;
00230	LABEL START,LABELA,LABELB,ZZZZ,FINISH;
00240	INTEGER ARRAY LEV1,LEV2,LEV3,LEV4,SEG1,SEG2,SEG3,SEG4,LEVH,SEGH[0:CNTSIZ];
00250	INTEGER ARRAY FEAT[0:7];
00260	INTEGER SFOUND,SGIVEN,SHRIGHT,SHWRONG,SHMISS,SPRIGHT,SPWRONG,SPMIX;
00270	INTEGER SPMISS,FOUND,GIVEN,HRIGHT,HWRONG,HMISS,PRIGHT,PWRONG,PMIX,PMISS;
00280	INTEGER HPOINT,HSTRT,HEND,FSTRT,FEND,RMIX,WMIX,SRMIX,SWMIX;
00290	STRING LAB;
00300	INTEGER CON1,CON2,CON3,CON4;
00310	
00320	DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00330	DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00340	DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00350	
00360	INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00370	BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00380	  BOOLEAN NF;
00390	  LOOKUP(CHAN,FILENAME,NF);
00400	  WHILE NF DO
00410	  BEGIN
00420	    OUTSTR(CR&LF&"Can't find "&FILENAME&". try [1,VIN],  File=");
00430	    FILENAME ← INCHWL ;
00440	    LOOKUP(CHAN,FILENAME,NF)
00450	  END;
00460	END "LOOKIN";
00470	
00480	PROCEDURE REPORT;
00490	BEGIN "REP"
00500	  INTEGER OUT,I,J,K,L;
00510	   IF TFLAG≠0 THEN BEGIN
00520		TFLAG←0;
00530	        FOR I←0 STEP 5 UNTIL TBLSIZ DO  BEGIN
00540	IF TABLET[I+1]=0 THEN DONE ELSE
00550	 IF (LDB(POINT(2,TABLET[I+2],12)))>0 THEN BEGIN "CT"
00560	 LAB←CVXSTR(TABLET[I+1]);   OUT←TABLET[I] ;
00570	 IF LDB(POINT(3,TABLET[I],20))-1 < LDB(POINT(3,TABLET[I+2],3)) THEN BEGIN
00580	   TABLET[I+2]←TABLET[I+2] LAND '770000000000;  DONE END;
00590	 IF EQU(LAB,"VOICED")∨EQU(LAB,"FRIC  ")∨EQU(LAB,"VOIFRI")
00600		∨EQU(LAB,"VS    ")∨EQU(LAB,"STOP  ")  THEN
00610	
00620	 BEGIN  LEV1[CON1]←TABLET[I+1];    SEG1[CON1]←OUT;
00630	  IF CON1<CNTSIZ THEN CON1←CON1+1 ELSE OUTSTR("Level 1 overflow"); END
00640	
00650	 ELSE IF
00660	EQU(LAB,"SCHWA ")∨EQU(LAB,"NASAL ")∨EQU(LAB,"GLIDE ")∨EQU(LAB,"VOWEL ")
00670	  THEN
00680	 BEGIN LEV2[CON2]←TABLET[I+1]; SEG2[CON2]←OUT;
00690	  IF CON2<CNTSIZ THEN CON2←CON2+1 ELSE OUTSTR("Level 2 overflow"); END
00700	
00710	 ELSE IF EQU(LAB,"S/T   ")∨EQU(LAB,"SH/K  ")∨EQU(LAB,"F/P   ") THEN
00720	 BEGIN  LEV3[CON3]←TABLET[I+1]; SEG3[CON3]←OUT;
00730	  IF CON3<CNTSIZ THEN CON3←CON3+1 ELSE OUTSTR("Level 3 overflow"); END
00740	
00750	 ELSE  BEGIN  LEV4[CON4]←TABLET[I+1]; SEG4[CON4]←OUT;
00760	  IF CON4<CNTSIZ THEN CON4←CON4+1 ELSE OUTSTR("Level 4 overflow"); END;
00770	TABLET[I+2]←TABLET[I+2] LAND '770000000000; END "CT"; END; END;
00780	END "REP";
00790	
00800	PROCEDURE ORDER;
00810	BEGIN "ORDER"
00820	INTEGER I,J,K,L;
00830	FOR I←0 STEP 1 UNTIL CON1-2 DO
00840	  FOR J←I+1 STEP 1 UNTIL CON1-1 DO
00850	    IF LDB(POINT(15,SEG1[J],17))<LDB(POINT(15,SEG1[I],17)) THEN
00860	      BEGIN K←LEV1[J]; LEV1[J]←LEV1[I]; LEV1[I]←K;
00870	            K←SEG1[J]; SEG1[J]←SEG1[I];SEG1[I]←K; END;
00880	FOR I←0 STEP 1 UNTIL CON2-2 DO
00890	  FOR J←I+1 STEP 1 UNTIL CON2-1 DO
00900	    IF LDB(POINT(15,SEG2[J],17))<LDB(POINT(15,SEG2[I],17)) THEN
00910	      BEGIN K←LEV2[J]; LEV2[J]←LEV2[I]; LEV2[I]←K;
00920	            K←SEG2[J]; SEG2[J]←SEG2[I]; SEG2[I]←K; END;
00930	FOR I←0 STEP 1 UNTIL CON3-2 DO
00940	  FOR J←I+1 STEP 1 UNTIL CON3-1 DO
00950	    IF LDB(POINT(15,SEG3[J],17))<LDB(POINT(15,SEG3[I],17)) THEN
00960	      BEGIN K←LEV3[J]; LEV3[J]←LEV3[I]; LEV3[I]←K;
00970	            K←SEG3[J]; SEG3[J]←SEG3[I]; SEG3[I]←K; END;
00980	FOR I←0 STEP 1 UNTIL CON4-2 DO
00990	  FOR J←I+1 STEP 1 UNTIL CON4-1 DO
01000	    IF LDB(POINT(15,SEG4[J],17))<LDB(POINT(15,SEG4[I],17)) THEN
01010	      BEGIN K←LEV4[J]; LEV4[J]←LEV4[I]; LEV4[I]←K;
01020	            K←SEG4[J]; SEG4[J]←SEG4[I]; SEG4[I]←K; END;
01030	END "ORDER";
01040	
01050	PROCEDURE CHART;
01060	BEGIN "CHART"
01070	INTEGER ARRAY LEVA,SEGA[0:800];
01080	INTEGER X,Y,Z,XX,YY,ZZ,LEVS,IMAX,P,Q,HSTRT,HLONG,HEND,HFLAG;
01090	STRING STR1,HINT;
01100	
01110	
01120	I←0;			⊂ Rearrange order for printing;
01130	FOR J←0 STEP 1 UNTIL 100 DO
01140	 IF LEV1[J]≠0 THEN BEGIN
01150	  LEVA[I]←LEV1[J]; SEGA[I]←SEG1[J]; LEV1[J]←0;
01160	  FOR K←J+1 STEP 1 UNTIL 100 DO
01170	   IF LEV1[K]=LEVA[I] THEN BEGIN
01180	    I←I+1; LEVA[I]←LEV1[K]; SEGA[I]←SEG1[K]; LEV1[K]←0; END;
01190	  I←I+1; END;
01200	LEVA[I]←CVSIX("ZZZZ"); I←I+1; ⊂ To produce a space;
01210	
01220	FOR J←0 STEP 1 UNTIL 100 DO
01230	 IF LEV2[J]≠0 THEN BEGIN
01240	  LEVA[I]←LEV2[J]; SEGA[I]←SEG2[J]; LEV2[J]←0;
01250	  FOR K←J+1 STEP 1 UNTIL 100 DO
01260	   IF LEV2[K]=LEVA[I] THEN BEGIN
01270	    I←I+1; LEVA[I]←LEV2[K]; SEGA[I]←SEG2[K]; LEV2[K]←0; END;
01280	  I←I+1; END;
01290	
01300	FOR J←0 STEP 1 UNTIL 100 DO
01310	 IF LEV3[J]≠0 THEN BEGIN
01320	  LEVA[I]←LEV3[J]; SEGA[I]←SEG3[J]; LEV3[J]←0;
01330	  FOR K←J+1 STEP 1 UNTIL 100 DO
01340	   IF LEV3[K]=LEVA[I] THEN BEGIN
01350	    I←I+1; LEVA[I]←LEV3[K]; SEGA[I]←SEG3[K]; LEV3[K]←0; END;
01360	  I←I+1; END;
01370	
01380	FOR J←0 STEP 1 UNTIL 100 DO
01390	 IF LEV4[J]≠0 THEN BEGIN
01400	  LEVA[I]←LEV4[J]; SEGA[I]←SEG4[J]; LEV4[J]←0;
01410	  FOR K←J+1 STEP 1 UNTIL 100 DO
01420	   IF LEV4[K]=LEVA[I] THEN BEGIN
01430	    I←I+1; LEVA[I]←LEV4[K]; SEGA[I]←SEG4[K]; LEV4[K]←0; END;
01440	  I←I+1; END;
01450	LEVA[I]←CVSIX("YYYY"); I←I+1; IMAX←I;
01460	LEVA[I]←0;	⊂ Set stop;
01470	
01480	I←J←LEVS←0; N←100; 
01490	
01500	WHILE I≤400 DO BEGIN "ISTEP"
01510	IF ((N-100) MOD 30)=0 THEN BEGIN 
01520	OUT(CHAN6,FF&CR&FILEI&TB&TB&TB&TB&TB&TB&TB&DATIME&CRLF);
01530	OUT(CHAN6,TB&TB&TB&TB&" time in 1.024 secs."&CRLF); END;
01540	 SETFORMAT(1,0); OUT(CHAN6,CRLF&"     "&CVS(N)[2 TO 2]&"."&CVS(N)[3 TO 3]);
01550	 Q←(N-100)*8; P←20;
01560	 FOR K←1 STEP 1 UNTIL 10 DO BEGIN N←N+1;
01570	  OUT(CHAN6,"  .  "&CVS(N)[2 TO 2]&"."&CVS(N)[3 TO 3]); END;
01580	 LEVS←J←0;
01590	
01600	 WHILE J=0 DO BEGIN "JSTEP"
01610	  IF LEVA[I]=0 THEN DONE;
01620	  IF LEVA[I]=CVSIX("ZZZZ") THEN BEGIN 
01630	   OUT(CHAN6,CRLF);
01640	   IF LEVA[IMAX-1]≠CVSIX("ZZZZ") THEN IF LEVA[IMAX-1]≠CVSIX("YYYY") THEN
01650	   BEGIN 
01660	   LEVA[IMAX]←CVSIX("ZZZZ"); IMAX←IMAX+1; LEVA[IMAX]←0;END; END ELSE
01670	
01680	  IF LEVA[I]=CVSIX("YYYY") THEN BEGIN 
01690	   IF LEVA[IMAX-1]≠CVSIX("YYYY") THEN IF LEVA[IMAX-1]≠CVSIX("ZZZZ") THEN
01700	   BEGIN J←1; OUT(CHAN6,CRLF);
01710	    LEVA[IMAX]←CVSIX("YYYY"); IMAX←IMAX+1; LEVA[IMAX]←0; END; END
01720	
01730	  ELSE BEGIN "SAME-J"
01740	
01750	   IF LEVA[I]≠LEVS THEN BEGIN LEVS←LEVA[I];
01760	    STR1←(CVXSTR(LEVS)&"     ")[1 TO 6];
01770	    Z←0; END;
01780	
01790	   XX←(LDB(POINT(15,SEGA[I],17)));
01800	
01810	   IF XX≥160 THEN BEGIN
01820	    SEGA[IMAX]←(SEGA[I] LAND '700000777777)+((XX-160) LSH 18);
01830	    LEVA[IMAX]←LEVA[I]; IMAX←IMAX+1; LEVA[IMAX]←0; END
01840	   ELSE BEGIN
01850	
01860	   IF Z=0 THEN OUT(CHAN6,CRLF&STR1);
01870	   X←(XX+1)%2; K←X-Z;
01880	   FOR L←1 STEP 1 UNTIL K DO OUT(CHAN6," ");
01890	   YY←LDB(POINT(15,SEGA[I],35)); Y←(YY+1)%2; Z←X+Y;
01900	   IF Z>80 THEN BEGIN
01910	     LEVA[IMAX]←LEVA[I];
01920	     SEGA[IMAX]←(SEGA[I] LAND '700000700000)+Z-79;
01930	     Y←81-X;
01940	     IMAX←IMAX+1; LEVA[IMAX]←0; END;
01950	
01960	    FOR L←1 STEP 1 UNTIL Y DO
01970	     IF L=2 THEN BEGIN   
01980	       K←LDB(POINT(3,SEGA[I],2))+LDB(POINT(3,SEGA[I],20))-6;
01990	       IF K<0 THEN K←0; OUT(CHAN6,CVS(K)) END
02000	     ELSE IF ((X+L-1) MOD 4)=0 THEN OUT(CHAN6,"+")
02010	     ELSE OUT(CHAN6,"-");
02020	    END;
02030	   IF J≠0 THEN DONE;
02040	   END "SAME-J";
02050	  I←I+1;
02060	  IF LEVA[I]=0 THEN DONE;
02070	  IF J≠0 THEN DONE;
02080	  END "JSTEP";
02090	
02100	IF LEVA[I]=0 THEN OUT(CHAN6,CRLF);
02105	IF LFILE[21]≠0 THEN BEGIN
02110	OUT(CHAN6," Pony "); HEND←-1; P←21;
02120	WHILE Q≤(N-100)*8 DO BEGIN
02130	 WHILE Q>HEND DO BEGIN
02140	 IF LFILE[P]=0 THEN BEGIN HSTRT←999; DONE; END;
02150	  HSTRT←((LDB(POINT(12,LFILE[P],23)))+1)%2;
02160	  HLONG←((LDB(POINT(12,LFILE[P],35)))+1)%2;
02170	  IF HLONG<2 THEN HLONG←2;
02180	  HEND←HSTRT+HLONG-1;
02190	 HINT←CVXSTR(LDB(POINT(12,LFILE[P],11)));
02200	HINT←HINT[5 TO 6];
02210	HFLAG←0;
02220	 P←P+1;
02230	 IF P≥127 THEN BEGIN OUTSTR("No HINTS"&CRLF); DONE END; END;
02240	IF P≥126 THEN DONE;
02250	
02260	  IF Q=HSTRT-1 THEN  BEGIN OUT(CHAN6,HINT); HFLAG←1; Q←Q+2; END ELSE
02270	  IF Q<HSTRT THEN BEGIN OUT(CHAN6," "); Q←Q+1; END ELSE
02280	  IF Q=HSTRT THEN BEGIN OUT(CHAN6,HINT); HFLAG←1; Q←Q+2; END ELSE
02290	   IF HFLAG=0 THEN BEGIN OUT(CHAN6,HINT); Q←Q+2; HFLAG←1; END ELSE
02300	  IF Q>HSTRT THEN BEGIN IF (Q MOD 4)=0 THEN OUT(CHAN6,"+") ELSE
02310	   OUT(CHAN6,"-"); Q←Q+1; END;
02320	
02330	 END; P←P-1; HEND←0;
02335	END;  OUT(CHAN6,CRLF&LF);
02340	 IF LEVA[I]=0 THEN DONE;
02350	 END "ISTEP";
02360	
02370	OUT(CHAN6,"Notes:  The + symbols denote scale divisions only."&CRLF&TB&
02390	 "The numbers on lines are confidence figures (unsigned, 0 to 8)."&CRLF);
02395	IF LFILE[21]≠0 THEN OUT(CHAN6,TB&
02400	"The position of pony data may not be exact because of scale compression."&crlf);
02420	END "CHART";
02430	
02440	PROCEDURE TESTER(INTEGER ARRAY LEV1,SEG1);
02450	BEGIN "TESTER"
02460	INTEGER RFLAG,WFLAG,MFLAG,CONF,RCONF,WCONF;
02470	
02475	OUT(CHAN6,CRLF);
02480	H←0;
02490	FOR I←21 STEP 1 UNTIL 127 DO BEGIN
02500	 IF LFILE[I]=0 THEN DONE;
02510	 K←LDB(POINT(12,LFILE[I],11)) LSH 24;
02520	 FOR J←0 STEP 1 UNTIL 63 DO IF K=PHLIST[J] THEN DONE ELSE
02530	  IF PHLIST[J]=0 THEN  DONE;
02550	 HPOINT←POINT(1,HLIST[J],-1);
02560	 FOR L←0 STEP 1 UNTIL 35 DO IF (ILDB(HPOINT)=1) THEN BEGIN
02580	  FOR K←0 STEP 1 UNTIL 7 DO IF FEAT[K]=FLIST[L] THEN BEGIN
02600	   LEVH[H]←FLIST[L]; SEGH[H]←LFILE[I];H←H+1; DONE END
02610	  ELSE IF FEAT[K]=0 THEN DONE;
02620	 END;
02630	END;
02650	
02660	FOR I←0 STEP 1 UNTIL 7 DO BEGIN "TAB"
02670	 IF FEAT[I]=0 THEN DONE;
02680	 GIVEN←HRIGHT←HWRONG←HMISS←RMIX←WMIX←J←0;
02690	
02700	 WHILE LEVH[J]≠0 DO BEGIN
02710	  WHILE LEVH[J]≠FEAT[I] DO BEGIN IF LEVH[J]=0 THEN DONE; J←J+1; END;
02720	  IF LEVH[J]=0 THEN DONE;
02730	  GIVEN←GIVEN+1; RFLAG←WFLAG←MFLAG←RCONF←WCONF←0;
02740	  HSTRT←LDB(POINT(12,SEGH[J],23));
02750	  HEND←LDB(POINT(12,SEGH[J],35))+HSTRT-1;
02760	  FOR K←0 STEP 1 UNTIL CNTSIZ DO BEGIN
02770	   IF (FSTRT←LDB(POINT(12,SEG1[K],17))+1)>HEND THEN
02780	    BEGIN IF (RFLAG+WFLAG)=0 THEN HMISS←HMISS+1;
02782	     IF MFLAG≠0 THEN BEGIN HWRONG←HWRONG-1; HRIGHT←HRIGHT-1;
02783	      IF RCONF≥WCONF THEN RMIX←RMIX+1 ELSE WMIX←WMIX+1; END;
02785	     DONE END;
02790	   IF (LDB(POINT(12,SEG1[K],35))+FSTRT-3)>HSTRT THEN BEGIN
02795	    CONF←LDB(POINT(3,SEG1[K],20));
02800	    IF LEV1[K]=FEAT[I] THEN BEGIN IF RFLAG=0 THEN HRIGHT←HRIGHT+1; RFLAG←1;
02805	     IF CONF>RCONF THEN RCONF←CONF; IF WFLAG=1 THEN MFLAG←1;
02815	     END ELSE BEGIN IF WFLAG=0 THEN  HWRONG←HWRONG+1; WFLAG←1;
02821	     IF CONF>WCONF THEN WCONF←CONF; IF RFLAG=1 THEN MFLAG←1; END;
02831	    END;
02835	  END;
02850	  J←J+1;
02860	 END;
02870	
02880	 FOUND←PRIGHT←PWRONG←PMIX←PMISS←K←0;
02890	WHILE LEV1[K]≠0 DO BEGIN
02900	 WHILE LEV1[K]≠FEAT[I] DO BEGIN IF LEV1[K]=0 THEN DONE; K←K+1; END;
02910	 IF LEV1[K]=0 THEN DONE;
02920	 FOUND←FOUND+1; RFLAG←WFLAG←MFLAG←0;
02930	  FSTRT←LDB(POINT(12,SEG1[K],17));
02940	  FEND←LDB(POINT(12,SEG1[K],35))+FSTRT-1;
02950	  FOR J←0 STEP 1 UNTIL CNTSIZ DO BEGIN
02960	   IF (HSTRT←LDB(POINT(12,SEGH[J],23)))>FEND THEN
02970	    BEGIN IF (RFLAG+WFLAG)=0 THEN PMISS←PMISS+1;
02975	     IF MFLAG≠0 THEN BEGIN PWRONG←PWRONG-1; PRIGHT←PRIGHT-1; END; DONE END;
02980	   IF (LDB(POINT(12,SEGH[J],35))+HSTRT-1)>FSTRT THEN
02990	    IF LEVH[J]=FEAT[I] THEN BEGIN IF RFLAG=0 THEN PRIGHT←PRIGHT+1; RFLAG←1;
03000	     IF WFLAG=1 THEN BEGIN IF MFLAG=0 THEN PMIX←PMIX+1; MFLAG←1; END;
03005	     END ELSE BEGIN IF WFLAG=0 THEN  PWRONG←PWRONG+1; WFLAG←1;
03015	     IF RFLAG=1 THEN BEGIN IF MFLAG=0 THEN PMIX←PMIX+1; MFLAG←1; END; END;
03020	  END;
03030	  K←K+1;
03040	 END;
03045	
03050	IF FEAT[I]=0 THEN DONE;
03060	IF (FOUND+GIVEN)≠0 THEN BEGIN OUT(CHAN6,
03072	CVS(GIVEN)&" "&CVS(HRIGHT)&" "&CVS(RMIX)&" "&CVS(WMIX)&" "&CVS(HWRONG)
03073	  &" "&CVS(HMISS)&TB&CVXSTR(FEAT[I])&TB&
03075	CVS(FOUND)&" "&CVS(PRIGHT)&" "&CVS(PMIX)&" "&CVS(PWRONG)&" "&CVS(PMISS)&CRLF);
03090	SFOUND←SFOUND+FOUND; SGIVEN←SGIVEN+GIVEN;
03100	SHRIGHT←SHRIGHT+HRIGHT; SHWRONG←SHWRONG+HWRONG; SHMISS←SHMISS+HMISS;
03105	SPRIGHT←SPRIGHT+PRIGHT; SPWRONG←SPWRONG+PWRONG; SPMIX←SPMIX+PMIX; SPMISS←SPMISS+PMISS;
03106	SWMIX←SWMIX+WMIX; SRMIX←SRMIX+RMIX;
03107	END;
03110	END "TAB";
03120	
03130	END "TESTER";
03140	
03150	PROCEDURE TEST;
03160	BEGIN "TEST"
03165	
03170	OUT(CHAN6,FF&TB&TB&TB&"  A.I. Laboratory"&
03171	  TB&CRLF&TB&TB&TB&"Stanford University"
03172	 &CRLF&LF&TB&"Segmentation data for ARPA Speech Segmentation Workshop"&CRLF);
03173	IF LFILE[21]≠0 THEN
03174	OUT(CHAN6,TB&"  Pony data after SCRL as spotted by R.Thosar or N.Miller"&crlf);
03175	OUT(CHAN6,CRLF&"Data file "&FILEI&"  "&TB&tb&TB&DATIME&CRLF);
03176	FOR I←10 STEP 1 UNTIL 20 DO OUT(CHAN6,CVXSTR(LFILE[I]));
03177	OUT(CHAN6,CRLF);
03178	IF MESS≠"" THEN OUT(CHAN6,"Trained on: "&MESS&CRLF);
03185	OUT(CHAN6,CRLF&TB&TB&TB&"Performance Analysis by Segments"&CRLF&LF);
03187	OUT(CHAN6,TB&"Teacher knows best"&TB&TB&TB&TB&"Program knows best"&CRLF);
03190	OUT(CHAN6," Given Right R-Mix W-Mix Wrong  Miss"&TB&"Feature"&TB
03193	         &" Found Right Mixed Wrong Extra"&CRLF);
03197	
03199	SGIVEN←SFOUND←SHRIGHT←SHWRONG←SRMIX←SWMIX←SHMISS←0;
03200	SPRIGHT←SPWRONG←SPMIX←SPMISS←0;
03201	SETFORMAT(5,0);
03210	FEAT[0]←CVSIX("STOP"); FEAT[1]←CVSIX("VOICED");
03220	FEAT[2]←CVSIX("FRIC"); FEAT[3]←CVSIX("VOIFRI");
03230	FEAT[4]←CVSIX("VS"); FEAT[5]←0;
03240	TESTER(LEV1,SEG1);
03250	
03260	FEAT[0]←CVSIX("SCHWA"); FEAT[1]←CVSIX("NASAL"); FEAT[2]←CVSIX("GLIDE");
03270	FEAT[3]←CVSIX("VOWEL"); FEAT[4]←0;
03280	TESTER(LEV2,SEG2);
03290	
03300	FEAT[0]←CVSIX("S/T"); FEAT[1]←CVSIX("SH/K"); FEAT[2]←CVSIX("F/P");
03310	FEAT[3]←0;
03320	TESTER(LEV3,SEG3);
03330	
03340	FEAT[0]←CVSIX("FRONT"); FEAT[1]←CVSIX("MID"); FEAT[2]←CVSIX("BACK");
03350	FEAT[3]←0;
03360	TESTER(LEV4,SEG4);
03365	OUT(CHAN6,CRLF);
03370	OUT(CHAN6,CVS(SGIVEN)&" "&CVS(SHRIGHT)&" "&CVS(SRMIX)&" "&CVS(SWMIX)
03375	  &" "&CVS(SHWRONG)&" "&CVS(SHMISS)&TB&"Totals"&TB&CVS(SFOUND)
03385	  &" "&CVS(SPRIGHT)&" "&CVS(SPMIX)&" "&CVS(SPWRONG)&" "&CVS(SPMISS)&CRLF);
03390	
03410	END "TEST";
     

00010	FILEI←"SEG1.T0[77,THO]";UPCNT←3;OPT1←"N";FILEC←0; CHAN4←4;CHAN6←6;
00040	TABIN(INTOT);
00045	OUTSTR("Trained on: (CR or type)="); MESS←INCHWL;
00047	
00050	IF STRIN("Should previous data be saved as TELL.DOC? (Y or CR) ")≠"Y" THEN
00051	BEGIN    OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF); ENTER(CHAN6,"TELL.DOC",0);
00055	 CLOSE(CHAN6); END ELSE
00060	IF STRIN("Should old TELL.DOC be spooled YorN = ")="Y" THEN
00070	BEGIN    OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF); LOOKUP(CHAN6,"TELL.DOC",0);
00080	  RENAME(CHAN6,"TELL.OLD",0,EOF); CLOSE(CHAN6);
00095	  SPOOL("TELL.OLD",GETCHAN,1); END;
00096	
00122	
00130	⊂ **** MAIN ROUTINE STARTS HERE****;
00140	START: CLOSE(CHAN6);
00160	IF OPT1≠"Y" THEN
00170	IF (TFILEI←STRIN("Data file FFT/LPC ("&FILEI&")="))≠"" THEN FILEI←TFILEI
00180	ELSE OPT1←"Y";
00190	IF OPT1="Y" THEN BEGIN FILEC←FILEC+1;  SETFORMAT(1,0);
00210	  FILEI←"SEG"&CVS(FILEC)&".T0[77,THO]";
00220	  OUTSTR("Starting on "&FILEI); END;
00250	
00260	 FOR I←0 STEP 5 UNTIL TBLSIZ-5 DO IF TABLET[I+1]=0 THEN DONE
00270	  ELSE BEGIN TABLET[I+2]←TABLET[I+2] LAND '770000000000;
00280	  TABLET[I+3]←0;  END; ⊂ INITIALISE FOR EVENT;
00290	FOR I←0 STEP 1 UNTIL CNTSIZ DO BEGIN LEV1[I]←LEV2[I]←LEV3[I]←LEV4[I]←0;
00300	SEG1[I]←SEG2[I]←SEG3[I]←SEG4[I]←0; END;
00310	CON1←CON2←CON3←CON4←0; CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00340	LOOKIN(CHAN4,FILEI); EOF←SEGC←SEGCNT←0;
00360	ARRYIN(CHAN4,LFILE[0],'200);	⊂ Input header;
00370	SEGTOT←(LFILE[0])*3%128; RATE←LFILE[2];
00375	OUTSTR(TB&"Segtot="&CVS(SEGTOT)&TB&"Sampling rate="&CVS(LFILE[2])&CRLF);
00390	IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
00400	
00420	OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF); LOOKUP(CHAN6,"TELL.DOC",0);
00440	DEFINE UGETF="'073000000000"; START_CODE; UGETF	6,I; END;
00480	ENTER(CHAN6,"TELL.DOC",0); USETO(CHAN6,I);
00510	OUT(CHAN6,TB&TB&TB&"  A.I. Laboratory"&
00515	  TB&CRLF&TB&TB&TB&"Stanford University"
00520	 &CRLF&LF&TB&"Segmentation data for ARPA Speech Segmentation Workshop"&CRLF);
00525	IF LFILE[21]≠0 THEN
00530	OUT(CHAN6,TB&"  Pony data after SCRL as spotted by R.Thosar or N.Miller"&crlf);
00540	OUT(CHAN6,CRLF&TB&"Data file "&FILEI&"  "&TB&TB&DATIME&CRLF&TB);
00547	FOR I←10 STEP 1 UNTIL 20 DO OUT(CHAN6,CVXSTR(LFILE[I]));
00558	OUT(CHAN6,CRLF);
00561	IF MESS≠"" THEN OUT(CHAN6,TB&"Trained on: "&MESS&CRLF);
00570	SETFORMAT(5,0);
00590	
00600	LABELA: ⊂ Put all outputs into the off state;
00610	FOR I←0 STEP 5 UNTIL TBLSIZ-5 DO
00620	 IF TABLET[I+1]≠0 THEN TABLET[I]←'777777777777 ELSE DONE;
00630	CON1←CON2←CON3←CON4←0;  HINT←H←0; TABLES[2]←HLIST[0];
00640	
00650	WHILE EOF=0 DO BEGIN "DATAIN"
00660	  ARRYIN(CHAN4,DATBUF[0],BUFSIZ); ⊂ Get data;
00670	  BPT←POINT(6,DATBUF[0],-1);
00680	  
00690	  FOR Q←1 STEP 1 UNTIL BUFSIZ%4 DO BEGIN  
00700	    SEGC←SEGC+1;
00710	    IF SEGC>SEGTOT THEN DONE;
00720	    FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00730	LABELB: SIG(P); REPORT;
00750	  END;
00760	IF SEGC>SEGTOT THEN DONE;
00770	END "DATAIN"; CLOSE(CHAN4);
00780	
00790	   FOR I←0 STEP 1 UNTIL INSIZ-1 DO  INDAT[I]←0;
00800	   FOR I←0 STEP 1 UNTIL 4 DO BEGIN SEGC←SEGC+1;  SIG(P); REPORT; END;
00830	
00840	⊂ **** Off line listing of counter outputs ****;
00850	ORDER;
00860	OUT(CHAN6,CRLF&TB&
00870	"In CMU units    SEG."&TB&"    Levels"&TB&" In units of 6.4 ms.");
00880	OUT(CHAN6,CRLF&TB&"Begin"&TB&"  End  "
00890	         &TB&"Label"&TB&"   Ave."&TB&"Max.  "&TB&"Begin"&TB&"  End"
00900		&TB&"Count"&CRLF);
00910	OUT(CHAN6,CRLF&TB&
00920	 "First level [voiced, fric., voiced-fric., voiced-stop, stop]"
00930	&CRLF);
00940	FOR I←0 STEP 1 UNTIL CON1-1 DO BEGIN
00950	 J←LDB(POINT(15,SEG1[I],17)); K←LDB(POINT(15,SEG1[I],35)); L←J+K-1;
00970	OUT(CHAN6,CRLF&TB&CVS(J LSH 6)&TB&CVS((L) LSH 6)&TB
00980	 &CVXSTR(LEV1[I])&TB&CVS(LDB(POINT(3,SEG1[I],2)))
00990	 &CVS(LDB(POINT(3,SEG1[I],20)))&TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01010	OUT(CHAN6,CRLF&LF&TB& "Voiced [vowel, glide, nasal]"&CRLF);
01020	
01030	 FOR I←0 STEP 1 UNTIL CON2-1 DO BEGIN
01040	 J←LDB(POINT(15,SEG2[I],17)); K←LDB(POINT(15,SEG2[I],35)); L←J+K-1;
01060	OUT(CHAN6,CRLF&TB&CVS(J LSH 6)&TB&CVS(L LSH 6)&TB
01070	 &CVXSTR(LEV2[I])&TB&CVS(LDB(POINT(3,SEG2[I],2)))
01080	 &CVS(LDB(POINT(3,SEG2[I],20)))&TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01110	   OUT(CHAN6,CRLF&LF&TB&"Fricatives [S/T, SH/K, F/P]"&CRLF);
01120	
01130	 FOR I←0 STEP 1 UNTIL CON3-1 DO BEGIN
01140	  J←LDB(POINT(15,SEG3[I],17)); K←LDB(POINT(15,SEG3[I],35)); L←J+K-1;
01160	OUT(CHAN6,CRLF&TB&CVS(J LSH 6)&TB&CVS(L LSH 6)
01170	  &TB&CVXSTR(LEV3[I])&TB&CVS(LDB(POINT(3,SEG3[I],2)))&
01180	  CVS(LDB(POINT(3,SEG3[I],20)))&TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01190	   OUT(CHAN6,CRLF&LF&TB&"Vowels [front, mid, back]"&CRLF);
01200	 FOR I←0 STEP 1 UNTIL CON4-1 DO BEGIN
01210	  J←LDB(POINT(15,SEG4[I],17)); K←LDB(POINT(15,SEG4[I],35));   L←J+K-1;
01230	OUT(CHAN6,CRLF&TB&CVS(J LSH 6)&TB&CVS(L LSH 6)
01240	  &TB&CVXSTR(LEV4[I])&TB&CVS(LDB(POINT(3,SEG4[I],2)))&
01250	 CVS(LDB(POINT(3,SEG4[I],20)))&TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01280	 OUT(CHAN6,CRLF);
01281	IF LFILE[21]≠0 THEN TEST;
01282	
01285	 CHART; OUT(CHAN6,FF);  CLOSE(CHAN6);
01290	
01340	GO TO START;
01360	FINISH:
01370	END "SEGMENT";